Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/database/graph_it/graph_pr.prg

Text File | 1987-06-23 | 23KB | 1,091 lines

***********************************************
* Filename: graph_pr.prg
* Author  : Roger J. Donnay
* Date    : June 23, 1987
*
* Notes   : The graphing procedures in this file may be called from
*           the file GRAPH_IT.PRG or from your own programs.
*           See file GRAPH_IT.PRG for documentation and calling
*           parameters.
*
* Donnay Software Systems
* 6151 Jasonwood Dr.
* Huntington Beach, CA 92648
* [phone]
*
* Check to see that you have the complete, unaltered source.  This file
* is   1091  lines,  22476  characters
************************************************

** Graph Parameters Maintenance Main Menu
PROC grphmenu

PUBLIC CLIPPER
PRIVATE colorp,ikey,code,lvalue

SELE I
SET TALK OFF
USE graph_it
LOCA FOR .t.
paint=.T.
file_open=.f.
lvalue=' '
code=' '
ikey=0
mfilt_desc=' '
DO WHILE .t.
  SELE graph_it
  SET DEVICE TO SCREEN
  IF paint
    DO grpaint
  ENDIF
  @ 14,21 GET grph_nmbr
  @ 15,21 GET title
  @ 16,21 GET file_name
  @ 17,21 GET indx_name
  @ 18,21 GET filt_desc
  @ 20,4 SAY 'Data file is'
  @ 20,17 SAY IIF(file_open,'OPEN  ','CLOSED')
  CLEAR GETS
  @ 22,0 CLEAR TO 23,79
  IF BOF()
    @ 22,40 SAY '** Top of file **'
  ENDIF
  IF EOF()
    @ 22,40 SAY '** Bottom of file **'
  ENDIF
  IF DELETE()
    @ 23,40 SAY '** Deleted **'
  ENDIF
  ikey=0
  @ 23,2 SAY 'Enter Selection'
  DO grtime
  @ 23,18 SAY code
  SET BELL ON
  DO CASE
    CASE (code='N' .OR. ikey=24) .AND. .NOT. EOF()
      SKIP
      SELE J
      USE
      file_open=.f.
    CASE (code='P' .OR. ikey=5) .AND. .NOT. BOF()
      SKIP -1
      SELE J
      USE
      file_open=.f.
    CASE code='T' .OR. ikey=1
      GOTO TOP
      SELE J
      USE
      file_open=.f.
    CASE code='B' .OR. ikey=6
      GOTO BOTT
      SELE J
      USE
      file_open=.f.
    CASE code='G' && Browse graph file
      DO grbrow
    CASE code='L' .OR. code='F' && Locate graph
      DO grlocate
    CASE code='C' && Continue locate
      CONT
    CASE code='S' && Display structure of data file
      DO grstru
    CASE code='D' &&Delete/Undelete
      IF DELETE()
        RECALL
      ELSE
        DELETE
      ENDIF
    CASE code='A'&& Add new record to graph parameter file
      DO gradd
    CASE code='E' .OR. code='V' && Edit or View graph parameters
      DO grscrn
    CASE code='U'&& Pack graph file
      DO grpack
    CASE code='J' && Draw graph
      DO grgraph
    CASE code='O' && Print graph file
      DO grprint
    CASE code='Z' && Open/Close datafile
      DO grfopen
    CASE code='Q' && Quit
      CLEAR
      SELE J
      USE
      SELE I
      USE
      RELE clipper
      RETURN
  ENDC
ENDDO

* - Paint menu on screen
PROC grpaint

paint=.f.
CLEAR
DO setcolor WITH 'BG'
@ 1,1 TO 21,78 DOUBLE
@ 3,2 TO 3,77
@ 13,2 TO 13,77
DO setcolor WITH 'G'
@ 2,20 SAY '** BAR GRAPH FILE MAINTENANCE MENU **'
@ 4,4  SAY 'E   Edit Parameters            L = Locate Record'
@ 5,4  SAY 'N = Go to Next record          C = Continue Locate'
@ 6,4  SAY 'P = Go to Previous record      V = View Parameters'
@ 7,4  SAY 'B = Go to bottom of file       J = Draw graph'
@ 8,4  SAY 'T = Go to top of file          G = Browse graph or data file'
@ 9,4  SAY 'U = Pack file                  O = Output Graph list to printer'
@ 10,4 SAY 'D = Delete/Undelete Record     A = Add new Record'
@ 11,4 SAY 'S = Display DBF Structure      Z = Open/Close Data file'
@ 12,4 SAY 'Q = QUIT'
DO setcolor WITH 'GR'
@ 14,4 SAY 'Graph Nmbr'
@ 15,4 SAY 'Title'
@ 16,4 SAY 'Data File Name'
@ 17,4 SAY 'Index File Name'
@ 18,4 SAY 'Filter'
DO setcolor WITH 'W,N/W'
RETURN

*(L)(F) Locate Parameter Record
PROC grlocate

lvalue='                         '
@ 22,1 SAY 'Enter FILE NAME, GRAPH NUMBER, or GRAPH DESCRIPTION to locate'
@ 23,1 GET lvalue
READ
IF lvalue=' '
  RETURN
ENDIF
lvalue=UPPER(TRIM(lvalue))
LOCA FOR UPPER(file_name)=lvalue .OR. grph_nmbr=lvalue .OR. ;
  AT(lvalue,UPPER(title))<>0
RETURN

*S Display Data Base Structure
PROC grstru

PRIVATE fc,l,field

SELE J
IF .NOT. file_open
  DO grfopen
ENDIF
IF .NOT. file_open
  RETURN
ENDIF
paint=.T.
CLEAR
IF .NOT. CLIPPER
  DISP STRU
ELSE
  fc=1
  l=1
  DO WHILE fc<=fcount()
    @ l,1 say STR(fc,3,0)
    @ l,5 SAY FIELDNAME(fc)
    field=FIELDNAME(fc)
    @ l,17 SAY TYPE('&field')
    fc=fc+1
    l=l+1
    IF l>20
      l=1
      WAIT
      CLEAR
    ENDIF
  ENDDO
ENDIF
WAIT
RETURN

*(G) Browse Data Base file
PROC grbrow

PRIVATE browcode

PAINT=.T.
CLEAR
DO SETCOLOR WITH 'BG'
@ 1,1 TO 11,78
DO SETCOLOR WITH 'G'
@ 2,25 SAY '** BROWSE FILE **'
@ 4,4 SAY 'G = Graph Parameter file'
@ 5,4 SAY 'D = Data file'
@ 7,4 SAY '<CR> =QUIT'
browcode=' '
DO setcolor WITH 'w'
@ 10,4 SAY 'Enter Selection' GET browcode PICT '!'
READ
IF browcode=' '
  RETURN
ENDIF
IF browcode='G'
  SELE graph_it
  DO browse
  SELE J
  USE
  file_open=.f.
ENDIF
IF browcode='D'
  mfilt_desc=filt_desc
  SELE J
  IF .NOT. file_open
    DO grfopen
  ENDIF
  IF .NOT. file_open
    RETURN
  ENDIF
  IF mfilt_desc=' '
    SET FILT TO
  ELSE
    SET FILT TO &mfilt_desc
    GOTO TOP
  ENDIF
  DO browse
ENDIF
RETURN


*(A) Add new Graph parameter record
PROC gradd

GOTO BOTT
STOR STR(VAL(grph_nmbr)+1,4,0) TO Mgrph_nmbr
APPE BLANK
REPL grph_NMBR WITH Mgrph_nmbr
DO grscrn
RETURN

*(E)(V) Edit/View Graph parameter record
PROC grscrn

PAINT=.T.
@ 1,0 CLEAR
DO setcolor WITH 'BG'
@ 1,1 TO 21,78
DO setcolor WITH 'GR,n/w'
@ 2,20 SAY '** GRAPH PARAMETERS **'
@ 4,4 SAY 'Graph Number' GET grph_nmbr
@ 5,4 SAY 'Graph Title ' GET title
@ 7,4 SAY 'File Name   ' GET file_name
@ 8,4 SAY 'Index Name  ' GET indx_name
@ 9,4 SAY 'Filter      ' GET filt_desc
@ 11,15 SAY 'TITLE          EXPRESSION'
@ 12,4 SAY 'Bar 1 '+CHR(219)+'  ' GET bardesc_1
@ 12,30 GET barexpr_1
@ 13,4 SAY 'Bar 2 '+CHR(176)+'  ' GET bardesc_2
@ 13,30 GET barexpr_2
@ 14,4 SAY 'Bar 3 '+CHR(177)+'  ' GET bardesc_3
@ 14,30 GET barexpr_3
@ 15,4 SAY 'Bar 4 '+CHR(178)+'  ' GET bardesc_4
@ 15,30 GET barexpr_4
@ 17,4 SAY 'Parameter' GET pdesc_1
@ 17,30 GET para_1
@ 19,4 SAY  'Bar Value Increment ' GET bar_incr
@ 19,40 SAY 'Parameter Spacing   ' GET p_space
@ 20,4 SAY 'V = Vertical BAR, H = Horizontal BAR, N = Numeric' GET gtype PICT '!'
DO setcolor WITH 'w,n/w'
IF code='V'
  CLEAR GETS
  STOR ' ' TO anykey
  @ 23,1 SAY 'Type any key to continue ' GET anykey
ENDIF
READ
RETURN


*(U) Pack graph parameter file
PROC grpack

anykey=' '
@ 22,1 SAY 'This selection will remove all records marked for deletion.'
@ 23,1 SAY 'Continue? (Y/N) ' GET anykey PICT '!'
READ
IF anykey<>'Y'
  RETURN
ENDIF
IF .NOT. CLIPPER
  paint=.t.
  CLEAR
ENDIF
SET TALK ON
PACK
IF .NOT. CLIPPER
  WAIT
ENDIF
SET TALK OFF
file_open=.f.
SELE J
USE
RETURN

*(O) Print Graph parameter file list
PROC grprint

PRIVATE mrecord

STOR RECNO() TO mrecord
CLEAR
? 'Turn on printer and set to top of form.'
WAIT
paint=.T.
SELE graph_it
IF CLIPPER
  REPORT FORM graph_it WHILE pr_ok() TO PRINT
ELSE
  REPORT FORM graph_it TO PRINT
ENDIF
EJECT
GOTO mrecord
RETURN


*(Z) Open or Close data file
PROC grfopen

PRIVATE mfilex,mindexx,anykey,mfile_name,mindx_name,indexon
IF file_open && Close file and return
  SELE J
  USE
  file_open=.f.
  RETURN
ENDIF
** Check for file existence
@ 22,0 CLEAR TO 23,79
@ 23,1 SAY 'Please wait...'
SELE graph_it
STOR TRIM(file_name)+'.DBF' TO mfilex
IF CLIPPER
  STOR TRIM(indx_name)+'.NTX' TO mindexx
ELSE
  STOR TRIM(indx_name)+'.NDX' TO mindexx
ENDIF
anykey=' '
mfile_name=TRIM(file_name)
mindx_name=TRIM(indx_name)
IF FILE('&mfilex')
  SELE J
  USE &mfile_name
ELSE
  @ 23,1 SAY 'File '+mfilex+' is not in directory. Type any key to continue';
  GET anykey
  READ
  SELE J
  USE
  file_open=.f.
  RETURN
ENDIF
anykey=' '
IF (mindx_name+' ')<>' '
  IF FILE('&mindexx')
    SET INDEX TO &mindx_name
  ELSE
    @ 22,1 SAY 'Index File '+mindexx+' is not in directory.'
    @ 23,1 SAY 'Create new index file?' GET anykey PICT '!'
    READ
    IF anykey='Y'
      indexon=REPL(' ',40)
      @ 23,0 CLEAR TO 23,79
      @ 23,1 SAY 'Index on:' GET indexon
      READ
      INDEX ON &indexon TO &mindx_name
      SET INDEX TO &mindx_name
    ELSE
      SET INDEX TO
    ENDIF
  ENDIF
ENDIF
file_open=.t.
RETURN

* Display time
PROC grtime

PRIVATE mtime
DO WHILE ikey=0
  DO disptime WITH 0,2
  mtime=TIME()
  DO WHILE mtime=TIME() .AND. ikey=0
    ikey=INKEY()
  ENDDO
ENDDO
CODE=IIF(ikey<32,' ',UPPER(CHR(ikey)))
RETURN

PROC disptime

PRIVATE x,y,tcorrect,textend
PARAMETERS x,y
tcorrect=0
textend=' am'
IF VAL(SUBSTR(time(),1,2))>11
  tcorrect=12
  textend=' pm'
ENDIF
IF VAL(SUBSTR(time(),1,2))=12
  tcorrect=0
ENDIF
@ X,Y SAY STR(VAL(SUBSTR(time(),1,2))-tcorrect,2,0)+SUBSTR(time(),3,6)+textend
RETURN


* Browse file
PROC browse

PRIVATE brpaint,fld_start,fld_nmbr,c,fld_name,mfld_name,l

paint=.T.
IF .NOT. CLIPPER
  BROWSE
  RETURN
ENDIF
CLEAR
SET DELIM OFF
SET INTE ON
DO setcolor WITH 'G'
@ 1,0 TO 4,78 DOUBLE
@ 2,2 SAY '^E ('+CHR(24)+')'
@ 3,2 SAY '^X ('+CHR(25)+')'
@ 2,10 SAY '= Move up one line'
@ 3,10 SAY '= Move down one line'
@ 2,32 TO 3,32
@ 2,33 SAY ' PgUp= Page up'
@ 3,33 SAY ' PgDn= Page down'
@ 2,56 TO 3,56
@ 2,57 SAY 'RET = Finish browse'
DO setcolor WITH 'W,N/W'
brpaint=.T.
fld_start=1
fld_nmbr=fld_start
c=0
DO WHILE fld_nmbr<=FCOUNT()
  STOR FIELD(fld_nmbr) TO fld_name
  @ 5,c SAY fld_name
  DO CASE
    CASE TYPE(fld_name)='C'
      c=c+LEN(&fld_name)+1
    CASE TYPE(fld_name)='M'
      c=c+50
    CASE TYPE(fld_name)='N' .OR. TYPE(fld_name)='D'
      c=c+11
  ENDCASE
  @ 5,c-1 SAY '         '
  fld_nmbr=fld_nmbr+1
  STOR FIELD(fld_nmbr) TO fld_name
  DO CASE
    CASE TYPE(fld_name)='C'
      IF c+LEN(&fld_name)>77
        EXIT
      ENDIF
    CASE TYPE(fld_name)='M'
      IF c+50>77
        EXIT
      ENDIF
  ENDCASE
  IF c+11>77
    EXIT
  ENDIF
ENDDO
Mfld_nmbr=fld_nmbr
DO WHILE .T.
  l=6
  @ l,0 CLEAR
  IF EOF()
    GOTO BOTT
  ENDIF
  STOR RECNO() TO BRSTART
  DO WHILE l<21 .AND. .NOT. EOF()
    c=0
    fld_nmbr=fld_start
    ?
    DO WHILE fld_nmbr<Mfld_nmbr
      STOR FIELD(fld_nmbr) TO fld_name
      IF TYPE(fld_name)='M'
        mfld_name=SUBSTR(&fld_name,1,50)
        ?? mfld_name
      ELSE
        ?? &fld_name
      ENDIF
      ?? ' '
      fld_nmbr=fld_nmbr+1
    ENDDO
    l=l+1
    SKIP
  ENDDO
  GOTO BRSTART
  l=7
  DO WHILE .T.
    STOR FIELD(1) TO fld_name
    ikey=0
    DO WHILE ikey=0
      ikey=INKEY()
      @ l,0 GET &fld_name
      CLEAR GETS
    ENDDO
    @ l,0 SAY &fld_name
    DO CASE
      CASE ikey=24 .AND. .NOT. EOF()
        l=l+1
        SKIP
        IF l>21
          EXIT
        ENDIF
      CASE ikey=13
        CLEAR
        SET DELIM ON
        ikey=0
        RETURN
      CASE ikey=5 .AND. .NOT. BOF()
        l=l-1
        SKIP -1
        IF l<7
          EXIT
        ENDIF
      CASE ikey=18 .AND. .NOT. BOF()
        SKIP -14
        l=l-14
        EXIT
      CASE ikey=3 .AND. .NOT. EOF()
        SKIP 14
        l=l+14
        EXIT
    ENDCASE
  ENDDO
ENDDO

* Check for escape key hit to abort print routine
FUNCTION pr_ok

PRIVATE m_request, m_continue
m_continue=.T.
IF INKEY()=27
  m_request=' '
  SET DEVICE TO SCREEN
  @ 24,1 SAY 'Printing paused. Q = Quit, R = Resume ';
   GET m_request PICT '!'
  SET ESCAPE OFF
  READ
  SET ESCAPE ON
  @ 24,0 CLEAR
  DO CASE
    CASE m_request='Q'
      m_continue=.F.
    CASE m_request='R'
      m_continue=.T.
  ENDCASE
ENDIF
RETURN (m_continue)


* set color attributes
PROC setcolor

PARAMETERS colorp

IF ISCOLOR()
  SET COLOR TO &colorp
ENDIF
RETURN


*(J) Draw Graph
PROC grgraph

PRIVATE mbarexpr_1,mbarexpr_2,mbar_expr_3,mbarexpr_4
PRIVATE mbar_incr,mpdesc_1,mpara_1,mgtype,mp_space,mtitle
PRIVATE mbardesc_1,mbardesc_2,mbardesc_3,mbardesc_4
PRIVATE mfilt_desc

paint=.T.
mtitle=title
mfilt_desc=filt_desc
mbardesc_1=TRIM(bardesc_1)
mbardesc_2=TRIM(bardesc_2)
mbardesc_3=TRIM(bardesc_3)
mbardesc_4=TRIM(bardesc_4)
mbarexpr_1=barexpr_1
mbarexpr_2=barexpr_2
mbarexpr_3=barexpr_3
mbarexpr_4=barexpr_4
mbar_incr=bar_incr
mpdesc_1=TRIM(pdesc_1)
mpara_1=para_1
mgtype=gtype
mp_space=p_space
SELE J
IF .NOT. file_open
  DO grfopen
ENDIF
IF .NOT. file_open
  RETURN
ENDIF
IF mfilt_desc=' '
  SET FILT TO
ELSE
  SET FILT TO &mfilt_desc
  GOTO TOP
ENDIF
DO grphdraw
RETURN

**  Draw graphs using parameters in GRAPH_IT.DBF file
PROC grphdrw

PARAMETERS mgrph_nmbr,file_open

PUBLIC CLIPPER
PRIVATE fname,alias

IF file_open
  IF CLIPPER
    fname=ALIAS()
    alias=fname
  ELSE
    DO alias
    fname=alias
  ENDIF
  IF LEN(alias)=0
    RELE alias
    RETURN
  ENDIF
ENDIF
RELE alias
SELE I
USE graph_it
LOCA FOR grph_nmbr=mgrph_nmbr
IF EOF()
  IF file_open
    SELE &fname
  ENDIF
  RETURN
ENDIF
mtitle=title
mfilt_desc=filt_desc
mbardesc_1=TRIM(bardesc_1)
mbardesc_2=TRIM(bardesc_2)
mbardesc_3=TRIM(bardesc_3)
mbardesc_4=TRIM(bardesc_4)
mbarexpr_1=barexpr_1
mbarexpr_2=barexpr_2
mbarexpr_3=barexpr_3
mbarexpr_4=barexpr_4
mbar_incr=bar_incr
mpdesc_1=TRIM(pdesc_1)
mpara_1=para_1
mgtype=gtype
mp_space=p_space
IF file_open
  SELE &fname
ELSE
  SELE J
  DO grfopen
  IF .NOT. file_open
    RETURN
  ENDIF
  fname='J'
  IF mfilt_desc=' '
    SET FILT TO
  ELSE
    SET FILT TO &mfilt_desc
    GOTO TOP
  ENDIF
ENDIF
DO grphdraw
SELE graph_it
USE
SELE &fname
RETURN

***************
* Proc   : ALIAS
* Author : Roger J. Donnay
* Date   : June 23, 1987
* Notes  : Returns the alias of the database file in the
*          current workspace.  Needed only in dBaseIII
*          Similar to ALIAS() function in clipper
* Syntax : DO alias
*          The alias will be returned in a variable named ALIAS
***************

PROC alias

PRIVATE b,c
PUBLIC alias
alias=DBF()
IF LEN(alias)=0
  RETURN
ENDIF
b=AT('.',alias)
alias=SUBSTR(alias,1,b-1)
DO WHILE .t.
  c=AT(':',alias)
  IF c=0
    EXIT
  ENDIF
  alias=SUBSTR(alias,c+1,LEN(alias)-c)
ENDDO
DO WHILE .t.
  c=AT('\',alias)
  IF c=0
    EXIT
  ENDIF
  alias=SUBSTR(alias,c+1,LEN(alias)-c)
ENDDO
RETURN

** This is here so the Clipper linker will not crash
FUNCTION DBF
RETURN 0


****************************************
* This section of procedures draws the graph on the screen.  Your datafile
* must be in the current selected area.  The graph will start at the
* current record.
*
* The following group of procedures can be placed in a seperate
* procedure file and the procedure "grphdraw" may be called from your
* dBaseIII or Clipper program to graph your database, starting at the
* current record.
*
* You need the following procedures:
*
*   grphdraw  -  main loop
*   grphdver  -  draw vertical bar graph
*   grphdhor  -  draw horizontal bar graph
*   grphdnum  -  draw numeric graph
*
*
* Enter with the following data variables:
*
* mtitle - String up to 40 chars (title of graph)
* mbardesc_1  -  String, up to 14 chars (description of Bar 1)
* mbardesc_2  -  String, up to 14 chars (description of Bar 2)
* mbardesc_3  -  String, up to 14 chars (description of Bar 3)
* mbardesc_4  -  String, up to 14 chars (description of Bar 4)
* mbarexpr_1  -  String, any length (any dbaseIII expression for Bar 1)
* mbarexpr_2  -  String, any length (any dbaseIII expression for Bar 2)
* mbarexpr_3  -  String, any length (any dbaseIII expression for Bar 3)
* mbarexpr_4  -  String, any length (any dbaseIII expression for Bar 4)
* mbar_incr   -  Numeric, (incremental value of graph)
* mpdesc_1    -  String, up to 14 chars (description of graphed data parameter)
* mpara_1     -  String, any length (any dbaseIII expression for parameter)
* mgtype      -  String, 1 char (V=Vertical, H=Horizontal, N=Numeric)
* mp_space    -  Numeric, (spacing between parameters on graph)
*
*****************************************

PROC grphdraw

PRIVATE startrec,endrec,grpaint,mrecord,vincr,x
PRIVATE l,c,p1,p2,p3,p4,vc,top,bott

CLEAR
grpaint=.T.
STOR ' ' TO anykey
STOR 0 TO endrec
DO WHILE .t.
  STOR RECNO() TO startrec
  IF mgtype='V' .AND. anykey<>'N'
    DO grphdver
  ENDIF
  IF mgtype='H' .AND. anykey<>'N'
    DO grphdhor
  ENDIF
  IF mgtype='N' .OR. anykey='N'
    DO grphdnum
    IF anykey='N'
      grpaint=.T.
    ENDIF
  ENDIF
  STOR RECNO() TO endrec
  STOR ' ' TO anykey
  @ 24,1 SAY;
  '<CR> = Cont., Q = QUIT, N = Numeric Chart, R = Goto new START record ';
   GET anykey PICT '!'
  READ
  IF anykey='N'
    GOTO startrec
    grpaint=.T.
  ENDIF
  IF anykey='R'
    @ 24,0 CLEAR
    STOR 0 TO mrecord
    @ 24,1 SAY 'Enter Record Number or <CR> to browse file' GET mrecord
    READ
    IF mrecord<1
      grpaint=.T.
      DO browse
    ELSE
      GOTO mrecord
    ENDIF
  ENDIF
  IF anykey='Q'
    RETURN
  ENDIF
ENDDO

* Draw vertical bar graph
PROC grphdver

IF grpaint
  CLEAR
ENDIF
DO setcolor WITH 'BG'
@ 5,8 CLEAR TO 20,77
@ 5,8 TO 5,77
@ 22,10 CLEAR TO 23,79
@ 24,0 CLEAR
IF grpaint
  @ 1,7 TO 21,78
  @ 3,8 TO 3,77
  DO setcolor WITH 'w'
  @ 21,7 SAY CHR(192)
  @ 2,10 SAY mtitle
  @ 4,10 SAY CHR(219)+' '+mbardesc_1
  @ 4,28 SAY CHR(176)+' '+mbardesc_2
  @ 4,46 SAY CHR(177)+' '+mbardesc_3
  @ 4,64 SAY CHR(178)+' '+mbardesc_4
  DO setcolor WITH 'w'
  vert=19
  vincr=mbar_incr
  DO WHILE vert>3
    DO CASE
      CASE vincr<1000
        @ vert,1 SAY vincr PICT '9999'
      CASE vincr>=1000 .AND. vincr<1000000
        x=vincr/1000
        @ vert,0 SAY x PICT '999.9'
        @ vert,5 SAY 'K'
      CASE vincr>1000000
        x=vincr/1000000
        @ vert,0 SAY x PICT '999.9'
        @ vert,5 SAY 'M'
    ENDCASE
    @ vert,7 SAY CHR(180)
    vincr=vincr+mbar_incr
    vert=vert-2
  ENDDO
  grpaint=.F.
ENDIF
horiz=11
DO setcolor WITH 'w'
@ 22,0 SAY mpdesc_1
l=23
DO WHILE horiz<79-mp_space .AND. .NOT. EOF()
  IF l=23
    l=22
  ELSE
    l=23
  ENDIF
  c=1
  @ l,horiz-1 SAY ' '
  @ l,horiz SAY &mpara_1
  IF mbarexpr_1<>' '
    vert=20
    vc=mbar_incr/2
    p1=&mbarexpr_1
    DO WHILE vc<p1 .AND. vert>5
      @ vert,horiz+c SAY CHR(219)
      vc=vc+mbar_incr/2
      vert=vert-1
    ENDDO
    IF vert=5
      @ vert,horiz+c SAY '^'
    ENDIF
    c=c+1
  ENDIF
  IF mbarexpr_2<>' '
    vert=20
    vc=mbar_incr/2
    p2=&mbarexpr_2
    DO WHILE vc<p2 .AND. vert>5
      @ vert,horiz+c SAY CHR(176)
      vc=vc+mbar_incr/2
      vert=vert-1
    ENDDO
    IF vert=5
      @ vert,horiz+c SAY '^'
    ENDIF
    c=c+1
  ENDIF
  IF mbarexpr_3<>' '
    vert=20
    vc=mbar_incr/2
    p3=&mbarexpr_3
    DO WHILE vc<p3 .AND. vert>5
      @ vert,horiz+c SAY CHR(177)
      vc=vc+mbar_incr/2
      vert=vert-1
    ENDDO
    IF vert=5
      @ vert,horiz+c SAY '^'
    ENDIF
    c=c+1
  ENDIF
  IF mbarexpr_4<>' '
    vert=20
    vc=mbar_incr/2
    p4=&mbarexpr_4
    DO WHILE vc<p4 .AND. vert>5
      @ vert,horiz+c SAY CHR(178)
      vc=vc+mbar_incr/2
      vert=vert-1
    ENDDO
    IF vert=5
      @ vert,horiz+c SAY '^'
    ENDIF
  ENDIF
  SKIP
  horiz=horiz+mp_space
ENDDO
RETURN

* Draw horizontal bar graph
PROC grphdhor

IF grpaint
  CLEAR
ENDIF
DO setcolor WITH 'bg'
@ 5,16 CLEAR TO 21,77
@ 5,16 TO 5,77
@ 0,0 CLEAR TO 21,14
IF grpaint
  @ 1,15 TO 22,78
  @ 3,16 TO 3,77
  DO setcolor WITH 'w'
  @ 22,15 SAY CHR(192)
  @ 2,16 SAY mtitle
  @ 4,16 SAY CHR(219)+' '+mbardesc_1
  @ 4,31 SAY CHR(176)+' '+mbardesc_2
  @ 4,46 SAY CHR(177)+' '+mbardesc_3
  @ 4,61 SAY CHR(178)+' '+mbardesc_4
  DO setcolor WITH 'w'
  hor=16
  vincr=mbar_incr
  DO CASE
    CASE mbar_incr*12<10000
      x=1
    CASE mbar_incr*12>=10000 .AND. mbar_incr*12<10000000
      x=1000
      @ 24,60 SAY 'Thousands (K)'
    CASE mbar_incr*12>=10000000
      x=1000000
      @ 24,60 SAY 'Millions (M)'
  ENDCASE
  DO WHILE hor<75
    @ 23,hor SAY vincr/x PICT '9999.9'
    vincr=vincr+mbar_incr
    hor=hor+5
  ENDDO
  @ 22,0 SAY mpdesc_1
  grpaint=.F.
ENDIF
vert=21
top=6
DO setcolor WITH 'w'
DO WHILE vert>top .AND. .NOT. EOF()
  @ vert,1 SAY &mpara_1
  IF mbarexpr_1<>' '
    p1=&mbarexpr_1
    IF p1<mbar_incr*12
      IF p1>0
        @ vert,16 SAY REPL(CHR(219),p1*5/mbar_incr-1)
      ENDIF
    ELSE
      @ vert,16 SAY REPL(CHR(219),12*5)+'>'
    ENDIF
    vert=vert-1
  ENDIF
  IF mbarexpr_2<>' '
    p2=&mbarexpr_2
    IF p2<mbar_incr*12
      IF p2>0
        @ vert,16 SAY REPL(CHR(176),p2*5/mbar_incr-1)
      ENDIF
    ELSE
      @ vert,16 SAY REPL(CHR(176),12*5)+'>'
    ENDIF
    vert=vert-1
  ENDIF
  IF mbarexpr_3<>' '
    p3=&mbarexpr_3
    IF p3<mbar_incr*12
      IF p3>0
        @ vert,16 SAY REPL(CHR(177),p3*5/mbar_incr-1)
      ENDIF
    ELSE
      @ vert,16 SAY REPL(CHR(177),12*5)+'>'
    ENDIF
    vert=vert-1
  ENDIF
  IF mbarexpr_4<>' '
    p4=&mbarexpr_4
    IF p4<mbar_incr*12
      IF p4>0
        @ vert,16 SAY REPL(CHR(178),p4*5/mbar_incr-1)
      ENDIF
    ELSE
      @ vert,16 SAY REPL(CHR(178),12*5)+'>'
    ENDIF
    vert=vert-1
  ENDIF
  vert=vert-mp_space
  SKIP
ENDDO
RETURN

* Draw Numeric chart
PROC grphdnum

@ 5,2 CLEAR TO 21,77
IF grpaint
  CLEAR
  DO setcolor WITH 'bg'
  @ 1,1 TO 22,78
  @ 3,2 TO 3,77
  DO setcolor WITH 'w'
  @ 2,4 SAY mtitle
  @ 4,4 SAY mpdesc_1
  @ 4,20 SAY mbardesc_1
  @ 4,35 SAY mbardesc_2
  @ 4,50 SAY mbardesc_3
  @ 4,65 SAY mbardesc_4
  grpaint=.F.
ENDIF
DO setcolor WITH 'w'
vert=6
bot=22
DO WHILE vert<bot .AND. .NOT. EOF() .AND. RECNO()<>endrec
  @ vert,2 SAY TRIM(&mpara_1)
  IF mbarexpr_1<>' '
    p1=&mbarexpr_1
    @ vert,22 SAY p1 PICT '9999999.999'
  ENDIF
  IF mbarexpr_2<>' '
    p2=&mbarexpr_2
    @ vert,37 SAY p2 PICT '9999999.999'
  ENDIF
  IF mbarexpr_3<>' '
    p3=&mbarexpr_3
    @ vert,52 SAY p3 PICT '9999999.999'
  ENDIF
  IF mbarexpr_4<>' '
    p4=&mbarexpr_4
    @ vert,67 SAY p4 PICT '9999999.999'
  ENDIF
  vert=vert+1
  SKIP
ENDDO
RETURN

*************************
*
* End of graphing procedures
*
*************************